home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / tool-inc.zip / GETFILES.INC < prev    next >
Text File  |  1989-06-02  |  4KB  |  187 lines
  1.  
  2. (*
  3.  * Copyright 1987, 1989 Samuel H. Smith;  All rights reserved
  4.  *
  5.  * This is a component of the ProDoor System.
  6.  * Do not distribute modified versions without my permission.
  7.  * Do not remove or alter this notice or any other copyright notice.
  8.  * If you use this in your own program you must distribute source code.
  9.  * Do not use any of this in a commercial product.
  10.  *
  11.  *)
  12.  
  13.  
  14. (*
  15.  * getfiles - file list processing library
  16.  *
  17.  * This module will change a wildcard list of files into a
  18.  * sorted file name list.
  19.  *
  20.  *)
  21.  
  22. const
  23.    maxnumfiles =  200;
  24.    null =         #0;
  25.  
  26. type
  27.    filestring =   string [64];
  28.    filearray =    array [1.. maxnumfiles] of filestring;
  29.  
  30.  
  31. var
  32.    filetable:     filearray;
  33.    filecount:     integer;
  34.  
  35.  
  36. (*
  37.  *
  38.  * sort a portion of a file table
  39.  *
  40.  *)
  41.  
  42.  
  43. procedure sorttable (var fdir:      filearray;
  44.                      first:         integer;
  45.                      last:          integer);
  46. var
  47.    i:             integer;
  48.    swapped:       boolean;
  49.    temp:          filestring;
  50.    
  51. begin
  52.  
  53.    repeat
  54.       swapped := false;
  55.  
  56.       for i := first to last - 1 do
  57.       begin
  58.  
  59.          if fdir [i]> fdir [i + 1] then
  60.          begin
  61.             temp := fdir [i];
  62.             fdir[i]:= fdir [i + 1];
  63.             fdir[i + 1]:= temp;
  64.             swapped := true;
  65.          end;
  66.       end;
  67.    until swapped = false;
  68. end;
  69.  
  70.  
  71. (*
  72.  *
  73.  * expand a comma-seperated wildcard list into
  74.  * a list of full pathnames.
  75.  * sort files going with each wildcard, but otherwise
  76.  * preserve file order
  77.  *
  78.  *)
  79.  
  80. procedure getfiles (patternlist:   filestring;
  81.                     var fdir:      filearray;
  82.                     var num:       integer);
  83. var
  84.    i:             integer;
  85.    cf:            byte;
  86.    onedir:        filestring;
  87.    listpos:       integer;
  88.    pattern:       filestring;
  89.    curdir:        filestring;
  90.    reg:           registers;
  91.    dta:           string[255];
  92.    c:             char;
  93.    prevnum:       integer;
  94.  
  95. begin
  96.    for i := 1 to length(patternlist) do
  97.       patternlist[i] := upcase(patternlist[i]);
  98.  
  99.    if patternlist = '-F' then   {filter standard input?}
  100.    begin
  101.       num := 1;         {make a fixed filelist instead of searching}
  102.       fdir[1] := '-F';
  103.       exit;
  104.    end;
  105.  
  106.    num := 0;
  107.    prevnum := 1;
  108.    listpos := 1;
  109.  
  110.    while listpos <= length (patternlist) do
  111.    begin
  112.       pattern := '';
  113.       c := patternlist [listpos];
  114.  
  115.       while (c <> ',') and (listpos <= length (patternlist)) do
  116.       begin
  117.          pattern := pattern + c;
  118.          listpos := succ(listpos);
  119.          c := patternlist [listpos];
  120.       end;
  121.  
  122.       listpos := succ(listpos);
  123.       curdir := pattern;
  124.  
  125.       while (length(curdir) > 0) and
  126.             (curdir [length(curdir)] <> '\') and
  127.             (curdir [length(curdir)] <> ':') do
  128.                curdir[0] := pred(curdir[0]);
  129.  
  130.       pattern := pattern + null;
  131.       reg.ax := $1a00;
  132.       reg.ds := seg (dta [1]);
  133.       reg.dx := ofs (dta [1]);
  134.       msdos(reg);              {set dta address}
  135.  
  136.       reg.ax := $4e00;
  137.       reg.cx := $21;  {match archive and read-only attributes}
  138.       reg.ds := seg (pattern [1]);
  139.       reg.dx := ofs (pattern [1]);
  140.       msdos(reg);              {find first matching file}
  141.  
  142.       cf := reg.flags and 1;
  143.  
  144.       while ((cf <> 1) and (num < maxnumfiles)) do
  145.       begin
  146.  
  147.          onedir := '';
  148.          i := 0;
  149.  
  150.          repeat
  151.             c := dta [31 + i];
  152.  
  153.             if c <> null then
  154.                onedir := onedir + c;
  155.  
  156.             i := i + 1;
  157.          until c = null;          {throw out the . and .. entries}
  158.  
  159.  
  160.          if onedir [1]<> '.' then
  161.          begin
  162.             num := num + 1;
  163.             fdir[num]:= curdir + onedir;
  164.          end;
  165.  
  166.          reg.ax := $4f00;
  167.          reg.ds := seg (dta [1]);
  168.          reg.dx := ofs (dta [1]);
  169.          msdos(reg);              {keep searching for next file}
  170.  
  171.          cf := reg.flags and 1;
  172.       end;
  173.  
  174.       sorttable(fdir, prevnum, num);
  175.                          {sort each part of list seperately}
  176.  
  177.       prevnum := num + 1;
  178.    end;
  179.  
  180.    if num >= maxnumfiles then
  181.    begin
  182.       writeln(con,'warning:  files in excess of ', maxnumfiles, ' ignored');
  183.    end;
  184. end;                     {getfiles}
  185.  
  186.  
  187.